home *** CD-ROM | disk | FTP | other *** search
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- ;; ;;
- ;; EuLisp Module Copyright (C) University of Bath 1991 ;;
- ;; ;;
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
- ;;; Xlisp code to drive an X window
-
- (defmodule driver
-
- (standard0 plists semaphores) () ()
-
- (deflocal lock (make-semaphore))
-
- (put 'x-service 'plot 0)
- (put 'x-service 'unplot 1)
- (put 'x-service 'read-pixmap 2)
- (put 'x-service 'clearwin 3)
- (put 'x-service 'redraw 4)
- (put 'x-service 'manage 5)
- (put 'x-service 'move 6)
- (put 'x-service 'plot-string 7)
- (put 'x-service 'unplot-string 8)
-
- (defun xgap (win) (prin " " win))
-
- (defun openwin ()
- (popen "xserver" 'output))
-
- (defun closewin (win)
- (pclose win))
-
- (defun xterpri (win) (newline win))
-
- (defun send-code (win service)
- (prin (get 'x-service service) win)
- (flush win)
- (xgap win))
-
- ;; plot pixmap at x y on window
- (defun plot (win pm x y)
- (open-semaphore lock)
- (send-code win 'plot)
- (prin pm win) (xgap win)
- (prin x win) (xgap win)
- (print y win)
- (flush win)
- (close-semaphore lock))
-
- ;; unplot pixmap at x y on window
- (defun unplot (win pm x y)
- (open-semaphore lock)
- (send-code win 'unplot)
- (prin pm win) (xgap win)
- (prin x win) (xgap win)
- (print y win)
- (flush win)
- (close-semaphore lock))
-
- ;; read a new pixmap
- (defun read-pixmap (win name)
- (open-semaphore lock)
- (send-code win 'read-pixmap)
- (print name win) ;; without quotes
- (xterpri win)
- (flush win)
- (close-semaphore lock))
-
- ;; clear the window
- (defun clearwin (win)
- (open-semaphore lock)
- (send-code win 'clearwin)
- (xterpri win)
- (flush win)
- (close-semaphore lock))
-
- ;; redraw the window
- (defun redraw (win)
- (open-semaphore lock)
- (send-code win 'redraw)
- (xterpri win)
- (flush win)
- (close-semaphore lock))
-
- ;; get the xserver to manage an object with pixmap pm
- ;; the server remembers the last position and unplots it for you
- ;; when you use move
- (defun manage (win pm)
- (open-semaphore lock)
- (send-code win 'manage)
- (print pm win)
- (flush win)
- (close-semaphore lock))
-
- ;; move a managed object
- (defun move (win obj x y)
- (open-semaphore lock)
- (send-code win 'move)
- (prin obj win) (xgap win)
- (prin x win) (xgap win)
- (print y win)
- (flush win)
- (close-semaphore lock))
-
- ;; plot a string
- (defun plot-string (win x y str)
- (open-semaphore lock)
- (send-code win 'plot-string)
- (prin x win) (xgap win)
- (print y win) (xgap win)
- (print str win)
- (flush win)
- (close-semaphore lock))
-
- ;; unplot it
- (defun unplot-string (win x y str)
- (open-semaphore lock)
- (send-code win 'unplot-string)
- (prin x win) (xgap win)
- (prin y win) (xgap win)
- (print str win)
- (flush win)
- (close-semaphore lock))
-
- (export plot unplot read-pixmap clearwin
- redraw manage move plot-string unplot-string)
-
- )
-